package Sgdb::Cntr::ProfilerPane;

use warnings;
use strict;
use integer;
use bytes;

use Math::BigInt;

require Tk::LabFrame;
use Tk::TableMatrix;

use Sgdb::Utils qw( :DEFAULT
                    gdb_source_map
                    foreach_target_symmetrix
                  );

my $MAXRANGES = 8;
my $modules_tbl;
my $modules_data = {};
my $module_filter = '';
my $target_mode = 'CURRENT';
my $mode = 'PROF';
my $time = 0;
my $lastdataname = 1;

init();

sub init { 1 }

sub new {

    my $self = shift or die 'whoami';
    my $topf = shift or die 'no topf';

    my $notebook = $topf->NoteBook();
    add_main_pane($notebook);

    hook_add 'close-current-profiler-pane', sub {
        my $tbl = shift or return;

        if($tbl->{'dirty'} != 0) {
            my $dlg = $tbl->Dialog(-title=>"Discard Results",
                                   -text=>"The results are not saved yet. Discard them?",
                                   -default_button=>"Cancel",
                                   -buttons=>["Discard","Cancel"]
                                 );
            my $sel = $dlg->Show(-global);
            return if $sel eq "Cancel";
        };

        $notebook and
        $notebook->Exists() and
        $notebook->delete($notebook->raised());
    };

    $notebook;
}

sub add_main_pane {

    my $notebook = shift;
    my $name = ' Main ';

    unless(defined $notebook->page_widget($name)) {

        my $frame = $notebook->add($name,
                                    -label=>$name,
                                    -anchor=>'w',
                                   );

        new_main_pane($frame, $notebook);
    }
    $notebook->raise($name);
}

sub new_main_pane {

    my ($topf, $notebook) =(@_);

    my @pref_button = pref 'profiler-pane-button';
    my @pref_entry  = pref 'profiler-pane-entry';
    my @pref_frame  = pref 'profiler-pane-frame';
    my $f;
    my $ft = $topf->Frame(@pref_frame
                         )->pack(-fill=>'x',-expand=>0,-anchor=>'nw');

    my @bg =('-background', $ft->cget('-background'));

    $f = $ft->LabFrame(-label=>'Directors:',@bg,-labelside=>"acrosstop"
                      )->grid(-row=>0,-column=>0,-sticky=>'ns');

    balloonset
    $f->Optionmenu(-options=>['CURRENT', 'ALL CONNECTED'],
                   -variable=>\$target_mode
                  )->grid(-row=>0,-column=>0,-sticky=>'w')=><<DoC;
Select wich director to profile.
NOTE:
CURRENT is the default mode that
profiles only the selected director.
ALL CONNECTED profiles all connected
directors running the same emulation
as the selected one.
DoC

    $f = $ft->LabFrame(-label=>'Ranges:',@bg,-labelside=>"acrosstop"
                      )->grid(-row=>1,-column=>0,-sticky=>'nsew');

    balloonset
    $f->Button(-text=>'Get',
               -command=>[\&runlocked, \&get_ranges],
               @pref_button
              )->grid(-row=>0,-column=>0,-padx=>10,-sticky=>'ew')=><<DoC;
Click to retrieve accumulated
data. The result is displayed
in the pane beneath, where
you can also use \(right-click\)
common edit, query, and info
functions.
DoC

    balloonset
    $f->Button(-text=>'Send',
               -command=>[\&runlocked, \&send_ranges],
               @pref_button
              )->grid(-row=>1,-column=>0,-padx=>10,-sticky=>'ew')=><<DoC;
Click to send the ranges specified
beneath to the machine.
DoC

    balloonset
    $f->Button(-text=>'Clear',
               -command=>[\&runlocked, \&clear_ranges],
               @pref_button,
               -foreground=>'red4',
               )->grid(-row=>0,-column=>1,-rowspan=>2,-padx=>10,-sticky=>'ew')=><<DoC;
Delete ranges sent
to the machine.
NOTE:
You should clear
ranges every time
you no longer need
the corresponding
statistics.
DoC

    $f = $ft->LabFrame(-label=>'Profiling:',@bg,-labelside=>"acrosstop"
                      )->grid(-row=>0,-column=>1,-rowspan=>2,-sticky=>'ns',-padx=>4);

    balloonset
    $f->Button(-text=>'Start',
               -command=>[\&runlocked, \&start_profile],
               @pref_button
              )->grid(-row=>0,-column=>0,-sticky=>'ew',-pady=>15)=><<DoC;
Start profiling.
NOTE:
You can profile only the sources
that have been compiled as profile
enabled.
DoC

    $f->Label(-text=>'mode:', @bg
             )->grid(-row=>0,-column=>1,-sticky=>'e');

    balloonset
    $f->Optionmenu(-options=>[qw/PROF TRAC ONCE/],
                   -variable=>\$mode
                  )->grid(-row=>0,-column=>2,-sticky=>'w')=><<DoC;
Select the Profiler mode.
NOTE:
PROF is the default mode that
collects statistics about specified
ranges until you stop it.
TRAC collects event traces and
will impact performance.
ONCE profiles each function just
once.
DoC

    $f->Label(-text=>'time:', @bg
             )->grid(-row=>1,-column=>1,-sticky=>'e');

    balloonset
    $f->Entry(-textvariable=>\$time,
              -validate  =>'key',
              -vcmd      =>sub {$_[0] =~ /^\d*$/},
              -width=>7,
              @pref_entry
             )->grid(-row=>1,-column=>2,-sticky=>'w')=><<DoC;
This value is optional, when set,
the profiler will stop after the specified number
of seconds.
DoC

    balloonset
    $f->Button(-text=>'Stop',
               -command=>[\&runlocked, \&stop_profile],
               @pref_button
              )->grid(-row=>1,-column=>0,-sticky=>'ew',-pady=>15)=><<DoC;
Stop profiling. This is
the same action as
issuing 83, 0 inline
command.
NOTE:
If you just close an
Sgdb session,you do
not stop profiling.
DoC

    $f = $ft->LabFrame(-label=>'View Results:',@bg,-labelside=>"acrosstop"
                      )->grid(-row=>0,-column=>2,-rowspan=>2,-sticky=>'ns');

    balloonset
    $f->Button(-text=>'     All     ',
               -command=>[\&runlocked, \&add_data_pane, $notebook],
               @pref_button
              )->grid(-row=>0,-column=>1,-columnspan=>3,-pady=>5)=><<DoC;
Display statistics
collected so far.
Data will be
displayed in a
separate Data pane.
DoC

    my ($rstart, $rend);

    balloonset
    $f->Button(-text=>'In Range:',
               -command=>[\&runlocked, \&add_data_pane, $notebook, \$rstart, \$rend],
               @pref_button
              )->grid(-row=>1,-column=>1,-columnspan=>3,-pady=>5)=><<DoC;
Click here to display selected
ranges in a separate Data pane.
DoC

    $f->Entry(-textvariable=>\$rstart,
              -width=>10,
              @pref_entry
             )->grid(-row=>2,-column=>1);

    $f->Label(-text=>'-', @bg
             )->grid(-row=>2,-column=>2);

    $f->Entry(-textvariable=>\$rend,
              -width=>10,
              @pref_entry
             )->grid(-row=>2,-column=>3);

    balloonset
    $ft->Button(-text=>'Close',
                -foreground=>'red4',
                -command=>[\&hook_run, 'close-current-data-pane' ],
                @pref_button
               )->grid(-row=>0,-rowspan=>2,-sticky=>'w',-column=>3)=><<DoC;
Close the Profiler pane.
NOTE:
Closing this pane does
not affect Profiler.
Profiling will keep
running until you
click Stop Profiling
or issue the 83, 0
inline command!
DoC

    # ranges frame
    $f = $topf->Frame(@pref_frame,
                     )->pack(-fill=>'both',-expand=>1,-anchor=>'nw');

    $f->Label(-text=>'Select Module to Profile', @bg
             )->pack(-fill=>'both',-expand=>0,-anchor=>'n');

    my $f_filter = $f->Frame(@pref_frame,
                            )->pack(-fill=>'both',-expand=>0,-anchor=>'n');

    $f_filter->Label(-text=>'Filter Modules:', @bg
                   )->pack(-fill=>'y',-expand=>0,-side=>'left',-anchor=>'w');

    my $e_module_filter = $f_filter->Entry(-textvariable=>\$module_filter,
                                           -width=>64,
                                           @pref_entry
                                          )->pack(-fill=>'x',-expand=>1,-side=>'left',-anchor=>'e');

    my @pref_tablematrix  = pref 'profiler-pane-tablematrix';
    balloonset
    my $mtf = $f->Scrolled('TableMatrix',
                           @pref_tablematrix,
                           -titlerows=>1, -titlecols=>1,
                           -colstretchmode=>'unset',
                           -resizeborders=>'col',
                           -cols=>9,
                           -selectmode=>'extended',
                           -cache=>0,
                           -variable=>$modules_data
                          )->pack(-fill=>'both',-expand=>1,-anchor=>'n',-side=>'top')=><<DoC;
Click on the column header
to sort table according
this column contents.
DoC

    $modules_tbl = $mtf->{SubWidget}->{'tablematrix'};
    $modules_tbl->MouseWheelBind("Tk::TableMatrix");
    $modules_tbl->tagConfigure('title', -fg=>'blue', -relief=>'sunken', -anchor=>'center');
    $modules_tbl->rowHeight(0,2);
    $modules_data->{"0,2"} = "Module";
    $modules_data->{"0,3"} = "Start\nAddress";
    $modules_data->{"0,4"} = "Size";
    $modules_data->{"0,5"} = "End\nAddress",
    $modules_data->{"0,6"} = "Range\nNo.",
    $modules_data->{"0,7"} = "Profile\nStart",
    $modules_data->{"0,8"} = "Profile\nEnd",

    $modules_tbl->colWidth(0=>5, 1=>1, 3=>8, 4=>8, 5=>8, 6=>5, 7=>8, 8=>8);
    $modules_tbl->tagConfigure('right', -anchor=>'e');
    $modules_tbl->tagCol('right',3,4,5,6,7,8);
    my $images = define_bitmaps($modules_tbl);
	$modules_tbl->tagConfigure('unchecked', -image=>$images->{unchecked}, -anchor=>'c');
	$modules_tbl->tagConfigure('checked', -image=>$images->{checked}, -anchor=>'c');
	$modules_tbl->bind('<ButtonRelease-1>',\&click_modules);
    $e_module_filter->bind('<KeyRelease>',\&show_modules);
    $modules_tbl->configure(-state=>'disabled');
    get_ranges();
    $modules_tbl->{'sortcol'} = 2;
    $modules_tbl->{'sortdir'} = 0;
    show_modules();

    my $swtich = \&new_symbol_file;
    for('target-was-switched',
          'target-was-detached',
          'new-symbol-file') { hook_add $_=>$swtich }

    $topf;
}

sub click_modules {

    my $active_row = $modules_tbl->index('active','row');
    my $active_col = $modules_tbl->index('active','col');
    if(($active_col == 1) and($active_row > 0)) {
        my $selected = gdb_cached('profiler-selected');
        my $active_module = $modules_data->{"$active_row,2"};
        my $active_module_selected = exists($selected->{$active_module});
        my @sel1 = $modules_tbl->curselection();
        for my $selidx(@sel1) {
            if($selidx =~ /(\d+),(\d+)/) {
                my ($row,$col) =($1,$2);
                my $module = $modules_data->{"$row,2"};
                if($active_module_selected) { # deselect it
                    delete($selected->{$module});
                    $modules_data->{"$row,1"} = 0;
                    $modules_tbl->tagCell('unchecked',"$row,1");
                } else {
                    my $start = hex $modules_data->{"$row,3"};
                    my $end = hex $modules_data->{"$row,5"};
                    $selected->{$module} = [$start,$end,-1];
                    $modules_data->{"$row,1"} = 1;
                    $modules_tbl->tagCell('checked',"$row,1");
                }
            }
        }
        my @rr = update_ranges($selected);
        gdb_cached('profiler-selected'=>$selected);
        show_modules();
        return;
    }
    return unless $active_col > 0;
    return unless $active_row == 0;

    my $old_sortcol = $modules_tbl->{'sortcol'};
    my $sortdir = $modules_tbl->{'sortdir'};

    if($modules_tbl->{'sortcol'} == $active_col) {
        $modules_tbl->{'sortdir'} =($modules_tbl->{'sortdir'}+1) % 2;
    }
    $modules_tbl->{'sortcol'} = $active_col;
    show_modules();
}

sub show_modules {

    gdb_cached('is-alive') or return;
    $modules_tbl->configure(-state=>'normal');
    my $map = gdb_source_map();
    my @modules = sort(keys(%{$map}));
    my $rows = $modules_tbl->cget("rows");
    my $cols = $modules_tbl->cget("cols");
    delete @{$modules_data}{map { my $col=$_; map {"$col,$_"}(0..$cols-1)}(1..$rows-1)};
    my $selected = gdb_cached('profiler-selected');
    my @tmp;
    my ($start_addr,$end_addr) = get_valid_code_range();
    for my $module(@modules) {
        my ($addr,$len,$ver,$tag,$status,$alias) = @{$map->{$module}};
        next unless $addr && $len;
        next unless ($addr >= $start_addr) && ($addr <= $end_addr);
        my $end = $addr+$len-1;
        my $sel =(defined $selected) &&(defined $selected->{$module});
        my ($pstart,$pend,$prange) =(-1,-1,-1);
        if($sel) {
           ($pstart,$pend,$prange) = @{$selected->{$module}};
        }
        my @map =($sel,$module,$addr,$len,$end,$prange,$pstart,$pend);
        push(@tmp,\@map);
    }
    my $sort_col = $modules_tbl->{'sortcol'};
    if($sort_col == 2) {
        @tmp = sort {$a->[$sort_col-1] cmp $b->[$sort_col-1]} @tmp;
    } else {
        @tmp = sort {$a->[$sort_col-1] <=> $b->[$sort_col-1]} @tmp;
    }
    if($modules_tbl->{'sortdir'} == 1) {
        @tmp = reverse(@tmp);
    }
    my $row = 1;
    for my $map(@tmp) {
        my ($sel,$module,$addr,$len,$end,$prange,$pstart,$pend) = @{$map};
        if($module_filter ne ''){
            if (index(sprintf("$module %x %x %x %x",$addr,$len,$end,$prange),$module_filter)<0) {
                next;
            }
        }
        $modules_data->{"$row,0"} = $row;
        my $tag = 'unchecked';
        $tag = 'checked' if $sel;
        $modules_data->{"$row,1"} = $sel;
        $modules_tbl->tagCell($tag,"$row,1");
        $modules_data->{"$row,2"} = $module;
        $modules_data->{"$row,3"} = sprintf("%x",$addr);
        $modules_data->{"$row,4"} = sprintf("%x",$len);
        $modules_data->{"$row,5"} = sprintf("%x",$end);
        $modules_data->{"$row,6"} = sprintf("%d",$prange) if $prange >= 0;
        $modules_data->{"$row,7"} = sprintf("%x",$pstart) if $pstart >= 0;
        $modules_data->{"$row,8"} = sprintf("%x",$pend)   if $pend >= 0;
        $row += 1;
    }
    $modules_tbl->configure(-variable=>$modules_data,-rows=>$row);
    $modules_tbl->configure(-state=>'disabled');
}

sub update_ranges {
    my $selected = shift;

    my $map = gdb_source_map();
    my @modules  =
      sort {$a->[0]<=>$b->[0]}
        grep {$_->[0] > 0 && $_->[1] > 0}
          map { [$map->{$_}->[0], $map->{$_}->[1]] }
            keys %{$map};

    my @mranges  = sort {$a->[0]<=>$b->[0]} map { [@{$selected->{$_}},$_] } keys %{$selected};

    @mranges  or return;
    @modules or return telthemloud "Select director to profile";

    my ($i, $start, $end) =(0);
    my @franges;

    while(@mranges) {
        my ($pstart,$pend,$prange,$pmodule) = @{shift @mranges};
        ${$selected->{$pmodule}}[2] = $i;
        my ($mstart,$msize) = @{shift @modules};
        my $mend = $mstart + $msize - 1;
        while($pstart > $mend) {
           ($mstart,$msize) = @{shift @modules};
            $mend = $mstart + $msize - 1;
            @modules or return telthemloud "Prof: Internal Error 1";
        }
        if($pend < $mend || !@mranges) {
            push(@franges,[$i,$pstart,$pend]);
            $i++;
            next;
        }
        $start = $pstart;
        $end = $mend;
        while(@mranges) {
           ($pstart,$pend,$prange,$pmodule) = @{shift @mranges};
            ${$selected->{$pmodule}}[2] = $i;
           ($mstart,$msize) = @{shift @modules};
            $mend = $mstart + $msize - 1;
            if($pstart > $mstart) {
                push(@franges,[$i,$start,$end]);
                unshift(@mranges,[$pstart,$pend,$prange,$pmodule]);
                $i++;
                last;
            }
            if($pend < $mend || !@mranges){
                push(@franges,[$i,$start,$pend]);
                $i++;
                last;
            }
            @mranges  or last;
            @modules or return telthemloud "Prof: Internal Error 2";
            $end = $mend;
        }
    }
    return @franges;
}

sub files_to_ranges {

    my $map = gdb_source_map();
    my @modules  =
      sort {$a->[0]<=>$b->[0]}
        grep {$_->[0] > 0 && $_->[1] > 0}
          map { [$map->{$_}->[0], $map->{$_}->[1]] }
            keys %{$map};
    my $selected = gdb_cached('profiler-selected');
    my @select  = sort {$a<=>$b} map { $map->{$_}->[0] } keys %{$selected};
    @select  or return telthemloud "Select modules to profile";
    @modules or return telthemloud "Select director to profile";
    my ($i, $start, $end) =(0);
    while(@select) {
        while($select[0] != $modules[0]->[0]) {
            shift @modules;
            @modules or return telthemloud "Prof: Internal Error 1";
        }
        $start = $select[0];
        while($select[0] == $modules[0]->[0]) {
            $end = $modules[0]->[0] + $modules[0]->[1] - 1;
            shift @modules;
            shift @select;
            @select  or last;
            @modules or return telthemloud "Prof: Internal Error 2";
        }
        $i ++;
    }
}

sub clear_ranges {
    foreach_target_symmetrix sub {
        my $dir = shift;
        my $res = gdb_exec 'symm-profiler C';
        if($res =~ /OK/) { telthem "$dir: Profiler ranges removed" }
        else             { telthemloud "$dir: $res" }
    }, $target_mode eq 'CURRENT';
    get_ranges();
}

sub send_ranges {

    my $selected = gdb_cached('profiler-selected');
    my @ranges = update_ranges($selected);
    if(scalar(@ranges)>$MAXRANGES) {
        telthemloud sprintf("Only %d ranges are supported, got %d.",$MAXRANGES,scalar(@ranges));
        return;
    }
    foreach_target_symmetrix sub {
        my $dir = shift;
        my $res = gdb_exec 'symm-profiler C';
        $res =~ /OK/  or return telthemloud "$dir: Error Clearing Old Ranges: $res";
        my $errors = 0;
        foreach my $r (@ranges) {
            my ($i,$start,$end) = @{$r};
            $res = gdb_exec sprintf("symm-profiler R:%d:%x:%x",$i,$start,$end);
            if($res =~ /^\s*(\d+)\s+functions\s+set/) {
                telthem "$dir: Range $i: $1 functions";
            }
            else {
                telthemloud "$dir: Range $i: Error: $res";
                $errors++;
            }
        }
        if ($errors) {
            get_ranges();
        }
    }, $target_mode eq 'CURRENT';
}

sub get_ranges {

    return unless gdb_cached('is-alive');
    my @ranges;
    my $res = gdb_exec('symm-profiler i:0:0');
    foreach my $line(split /^/, $res) {
        if($line =~ m{^Range \s+(\d+)        \s+
                         Start \s+(0x[\da-f]+) \s+
                         End   \s+(0x[\da-f]+)
                         }x) {
            my ($i,$start,$end) = map {hex}($1, $2, $3);
            push(@ranges,[$i,$start,$end]) if($start < $end) && $end;
        }
        elsif($line =~ /^Time .* Limit \s+(0x[a-f\d]+)/) {
            $time = hex $1;
        }
    }
    ranges_to_files(\@ranges);
}

sub ranges_to_files {
    my $ranges = shift;

    my $map = gdb_source_map();
    my %selected;
    foreach my $r(@$ranges) {
        my ($i,$start,$end) = @{$r};
        next if $start >= $end;
        map {
            my ($m,$M) =($map->{$_}->[0],$map->{$_}->[0]+$map->{$_}->[1]-1);
            if($m < $start) {
                $m = $start;
                $M = $end if($M > $end);
            } else {
                $M = $end if($M > $end);
            }
            $selected{$_} = [$m,$M,$i];
        }
          grep {($map->{$_}->[0] < $end) &&(($map->{$_}->[0]+$map->{$_}->[1]-1) > $start) }
            keys %{$map};
    }
    gdb_cached('profiler-selected'=>\%selected);
    $modules_tbl->{'sortcol'} = 6;
    $modules_tbl->{'sortdir'} = 1;
    show_modules();
}

sub start_profile {
    my $m = join '', map { sprintf "%lx", ord  } split '', $mode;
    $time ||= 0;
    foreach_target_symmetrix sub {
        my $dir = shift;
        my $res = gdb_exec("symm-profiler A:$m:$time") or return;
        if($res =~ /OK/) { telthem "$dir: Profiler started" }
        else             { telthemloud "$dir: $res" }
    }, $target_mode eq 'CURRENT';
}

sub stop_profile {
    foreach_target_symmetrix sub {
        my $dir = shift;
        my $res = gdb_exec("symm-profiler Z") or return;
        if($res =~ /OK/) { telthem "$dir: Profiler stopped" }
        else             { telthemloud "$dir: $res" }
    }, $target_mode eq 'CURRENT';
}

sub add_data_pane {

    return unless gdb_cached('is-alive');
    my $notebook = shift;
    my $name;
    foreach_target_symmetrix sub {
        my $dir = shift;
        $name = "$dir Data" . $lastdataname ++;
        unless(defined $notebook->page_widget($name)) {
            my $frame = $notebook->add($name, -label=>$name, -anchor=>'w');
            new_data_pane($frame, @_);
        }
    }, $target_mode eq 'CURRENT';
    $notebook->raise($name);
}

sub new_data_pane {

    my $topf = shift;

    my $head = $topf->Frame(pref 'profiler-pane-frame'
                           )->pack(-fill=>'x',-expand=>0,-side=>'top');

    my $info = $head->Frame(pref 'profiler-pane-frame'
                           )->pack(-fill=>'y',-expand=>1,-side=>'left');

    my $cmd = $head->Frame(pref 'profiler-pane-frame'
                          )->pack(-fill=>'y',-expand=>0,-side=>'right');

    $info->Label(-text=>scalar localtime(),
                 -background=>$info->cget(-background),
                )->pack(-anchor=>'nw');

    my %tdata;
    my %sortm;
    my @pref_tablematrix  = pref 'profiler-pane-tablematrix';
    balloonset
    my $t = $topf->Scrolled('TableMatrix',
                            @pref_tablematrix,
                            -titlerows=>2, -titlecols=>1,
                            -roworigin=>-1,
                            -colstretchmode=>'unset',
                            -resizeborders=>'col',
                            -cols=>10,
                            -selectmode=>'extended',
                            -cache=>0,
                            -variable=>\%tdata,
                           )->pack(-fill=>'both',-expand=>1)=><<DoC;
Click on the column header
to sort table according
this column contents.
DoC

    my $tbl = $t->{SubWidget}->{'tablematrix'};
    $tbl->MouseWheelBind("Tk::TableMatrix");
    $tbl->tagConfigure('title',-fg=>'blue',-relief=>'sunken',-anchor=>'center');
    $tbl->rowHeight(0,2);
    $tbl->spans("-1,6"=>"0,1");
    my $c;
    $tbl->spans("-1,0"=>"1,0");
    $c = 1; $tdata{"-1,$c"} = "Number\n  of\nCalls"; $sortm{$c} = 'num';
    $tbl->spans("-1,$c"=>"1,0");
    $c = 2; $tdata{"-1,$c"} = "Time (usec)";
    $tbl->spans("-1,$c"=>"0,1");
    $c = 2; $tdata{"0,$c"} = "Self";             $sortm{$c} = 'num';
    $c = 3; $tdata{"0,$c"} = "Total";            $sortm{$c} = 'num';
    $c = 4; $tdata{"-1,$c"} = "Average Time (usec)";
    $tbl->spans("-1,$c"=>"0,1");
    $c = 4; $tdata{"0,$c"} = "Self";             $sortm{$c} = 'num';
    $c = 5; $tdata{"0,$c"} = "Total";            $sortm{$c} = 'num';
    $c = 6; $tdata{"-1,$c"} = "Routine";
    $tbl->spans("-1,$c"=>"0,3");
    $c = 6; $tdata{"0,$c"} = "Name";             $sortm{$c} = 'str';
    $c = 7; $tdata{"0,$c"} = "File";             $sortm{$c} = 'str';
    $c = 8; $tdata{"0,$c"} = "Address\n(hex)";  $sortm{$c} = 'num';
    $c = 9; $tdata{"0,$c"} = "Index\n(hex)";     $sortm{$c} = 'num';

    $tbl->colWidth(0=>7, 1=>12, 2=>12, 3=>12, 4=>9, 5=>9, 8=>9, 9=>7);
    $tbl->tagConfigure('right', -anchor=>'e');
    $tbl->tagConfigure('left', -anchor=>'w');
    $tbl->tagCol('right',0..5,8,9);
    $tbl->tagCol('left',6,7);
    $tbl->{'sortcol'} = 1;
    $tbl->{'sortdir'} = 1;
    $tbl->{'pdata'} = get_data(@_);
    $tbl->{'sortm'} = \%sortm;
	$tbl->bind('<ButtonRelease-1>',\&click_result_tbl);
	$tbl->bind('<Double-1>',\&double_click_result_tbl);
    $tbl->{'dirty'} = 0;
    if (keys(%{$tbl->{'pdata'}})){
        $tbl->{'dirty'} = 1;
    }
    show_prof_results($tbl);
    $tbl->configure(-state=>'disabled');
    $t->bind('<Control-1>', [\&info_line_lookup ]);

    my @pref_button = pref 'profiler-pane-button';
    balloonset
    $cmd->Button(-text=>'Save',
                  -command=>[\&save_profiler_data, $tbl],
                  @pref_button
                )->pack(-fill=>'y',-expand=>0,-side=>'right',-padx=>2)=><<DoC;
Save collected statistics.
DoC
    balloonset
    $cmd->Button(-text=>'Close',
                  -command=>[\&hook_run, 'close-current-profiler-pane', $tbl],
                  @pref_button
                )->pack(-fill=>'y',-expand=>0,-side=>'right',-padx=>2)=><<DoC;
Discard collected statistics
and close current pane.
DoC

    $t;
}

sub bighex{Math::BigInt->new($_);};

sub parse_prof_results {
    my $data = shift;
    my $res = shift;

    my ($index,$addr,$calls,$self,$total) = (0);
    foreach my $line(split /^/, $res) {
        if($line =~ m{^(0x[\da-f]+) \s+
                      (0x[\da-f]+) \s+
                      (0x[\da-f]+) \s+
                      (0x[\da-f]+) \s+
                      (0x[\da-f]+) }x) {
            ($index,$addr,$calls,$self,$total) = map {bighex}($1,$2,$3,$4,$5);
            if($calls) {
                if(!defined $data->{$index}) {
                    my ($func,$filename) = get_func_info($addr);
                    $data->{$index} = [$index,$addr,$calls,$self,$total,$func,$filename];
                }
            }
        } elsif($line !~ /^Index/) {
            telthem "Error: $line";
        }
    }
    return $index;
}

sub get_data {
    my ($start,$end) = @_;

    my %data;
    my $res;
    if($end) {
        $$start ||= 0;
        $$end   or return telthemloud "Invalid Range";
        $start = sprintf "%x", hex $$start;
        $end   = sprintf "%x", hex $$end;
        my $delta = hex($end)-hex($start);
        $delta > 0 or return telthemloud "Invalid Range";
        $delta = sprintf "%x",$delta;
        $res = gdb_exec_quiet "symm-profiler r:$start:$delta";
        parse_prof_results(\%data,$res);
    } else {
        my $i=0;
        my $chunk_size = 100;
        my $sanity=1000;
        while(-- $sanity) {
            $res =  gdb_exec_quiet sprintf("symm-profiler a:%x:%x",$i,$chunk_size);
            my $last_idx = parse_prof_results(\%data,$res);
            last if $last_idx == 0;
            $i = $last_idx + 1;
        }
    }
    \%data;
}

sub double_click_result_tbl {
    my $tbl = shift;

    my $row = $tbl->index('active','row');
    return unless $row > 0;
    my $tdata = $tbl->cget("-variable");
    return unless $tdata;
    my $addr = $tdata->{"$row,8"};
    return unless $addr;
    gdb_exec("info line *0x$addr");
}

sub click_result_tbl {
    my $tbl = shift;
    my $row = $tbl->index('active','row');
    my $col = $tbl->index('active','col');
    return unless ($col > 0) && ($row <= 0);
    my $old_sortcol = $tbl->{'sortcol'};
    my $sortdir = $tbl->{'sortdir'};
    if($tbl->{'sortcol'} == $col) {
        $tbl->{'sortdir'} =($tbl->{'sortdir'}+1) % 2;
    }
    $tbl->{'sortcol'} = $col;
    show_prof_results($tbl);
}

sub show_prof_results {
    my $tbl = shift;

    my $tdata = $tbl->cget("-variable");
    my $data = $tbl->{'pdata'};
    $tbl->configure(-state=>'normal');
    my $rows = $tbl->cget("rows");
    my $cols = $tbl->cget("cols");
    my $sortcol = $tbl->{'sortcol'};
    my $sortm = $tbl->{'sortm'}->{$sortcol};
    delete @{$tdata}{map { my $col=$_; map {"$col,$_"}(0..$cols-1)}(1..$rows-1)};
    my @tmp;
    while(my ($i,$pl)=each(%$data)) {
        my ($index,$addr,$calls,$self,$total,$func,$filename) = @$pl;
        my ($pself,$ptotal) =(0.0,0.0);
        if($calls) {
            no integer;
           ($pself,$ptotal) =($self/$calls,$total/$calls);
        }
        my @map =(0,$calls,$self,$total,$pself,$ptotal,$func,$filename,$addr,$index);
        my $key = $map[$sortcol];
        $map[0] = $key;
        push(@tmp,\@map);
    }
    if($sortm eq 'num') {
        @tmp = sort {$a->[0] <=> $b->[0]} @tmp;
    } else {
        @tmp = sort {$a->[0] cmp $b->[0]} @tmp;
    }
    if($tbl->{'sortdir'} == 1) {
        @tmp = reverse(@tmp);
    }
    my $row = 1;
    for my $map(@tmp) {
        my ($x,$calls,$self,$total,$pself,$ptotal,$func,$filename,$addr,$index) = @{$map};
        $tdata->{"$row,0"} = $row;
        $tdata->{"$row,1"} = $calls;
        $tdata->{"$row,2"} = $self;
        $tdata->{"$row,3"} = $total;
        $tdata->{"$row,4"} = sprintf("%15.4g",$pself);
        $tdata->{"$row,5"} = sprintf("%15.4g",$ptotal);
        $tdata->{"$row,6"} = $func;
        $tdata->{"$row,7"} = $filename;
        $tdata->{"$row,8"} = sprintf("%x",$addr);
        $tdata->{"$row,9"} = sprintf("%x",$index);
        $row += 1;
    }
    $tbl->configure(-variable=>$tdata,-rows=>$row+1);
    $tbl->configure(-state=>'disabled');
}

sub get_valid_code_range {

    my ($start_addr,$end_addr) = (0,0xFFFFFFFF);
    my $l = gdb_exec_quiet("p/x cs_code_start_addr");
    if ($l =~ /\$\d+\s+=\s+0x(.+)$/) {
        $start_addr = hex($1);
    }
    $l = gdb_exec_quiet("p/x cs_code_end_addr");
    if ($l =~ /\$\d+\s+=\s+0x(.+)$/) {
        $end_addr = hex($1);
    }
    return ($start_addr,$end_addr);
}

sub get_func_info {
    my $addr = shift;

    my ($func,$filename) =('');
    if($addr) {
        my $infoline = gdb_exec_quiet("info line *$addr");
        if($infoline =~ /\<(\w+)\>/) {
            $func = $1;
        }
        if($infoline =~ /\"(.*)\"/) {
            $filename = $1;
        }
    }
    return($func,$filename);
}

sub save_profiler_data {
    my $tbl = shift or return;

    my $rows = $tbl->cget("rows");
    $rows or return;
    my $cols = $tbl->cget("cols");
    my $tdata = $tbl->cget("-variable");

    my $file = find_file(1,
                         'Save Profile Data as ..',
                         pref('last-profiler-save-filename') || '',
                        );
    $file or return;
    open FILE, ">$file" or return telthemloud "cannot open file '$file': $!";

    for my $row(1..$rows-1) {
        my @row;
        for my $col(1..$cols-1) {
            push(@row,$tdata->{"$row,$col"});
        }
        print FILE join("\t",@row), "\n";
    }
    close FILE;
    pref_set 'last-profiler-save-filename', $file;
    $tbl->{'dirty'} = 0;
    $file;
}

sub new_symbol_file {

    return unless istkwidget $modules_tbl;
    get_ranges();
}

sub define_bitmaps
{
	my ($w) = @_;

    my $unchecked_button =
'
/* XPM */
static char * xpm[] = {
"9 8 3 1",
" 	c None",
"@	c #B8B8B8",
"+	c #555555",
"+++++++++",
"++++++++@",
"++     @@",
"++     @@",
"++     @@",
"++     @@",
"++@@@@@@@",
"+@@@@@@@@"};
};
';

    my $checked_button =
'
/* XPM */
static char * xpm[] = {
"9 8 4 1",
" 	c None",
"@	c #B8B8B8",
"+	c #555555",
".	c #FF0000",
"+++++++++",
"++++++++@",
"++.....@@",
"++.....@@",
"++.....@@",
"++.....@@",
"++@@@@@@@",
"+@@@@@@@@"};
};
';
	my %images;
	$images{unchecked} = $w->Pixmap('unchecked_button', -data=>$unchecked_button);
	$images{checked} = $w->Pixmap('checked_button', -data=>$checked_button);
	\%images;
}
